home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / GNUST / Demos / printHier < prev    next >
Text File  |  1991-09-13  |  2KB  |  61 lines
  1. "Print out the class inheritance hierarchy."
  2.  
  3. "======================================================================
  4. |
  5. | Copyright (C) 1990, 1991 Free Software Foundation, Inc.
  6. | Written by Steve Byrne.
  7. |
  8. | This file is part of GNU Smalltalk.
  9. |
  10. | GNU Smalltalk is free software; you can redistribute it and/or modify it
  11. | under the terms of the GNU General Public License as published by the Free
  12. | Software Foundation; either version 1, or (at your option) any later version.
  13. | 
  14. | GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
  15. | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  16. | FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  17. | details.
  18. | 
  19. | You should have received a copy of the GNU General Public License along with
  20. | GNU Smalltalk; see the file LICENSE.  If not, write to the Free Software
  21. | Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
  22. |
  23.  ======================================================================"
  24.  
  25.  
  26.  
  27. !Behavior methodsFor: 'demo'!
  28.  
  29. printHierarchy
  30.     "I my entire subclassclass hierarchy on the terminal."
  31.     self printSubclasses: 0    
  32. !!
  33.  
  34. !Behavior methodsFor: 'private'!
  35.  
  36. printSubclasses: level
  37.     "I print my name, and then all my subclasses, each indented according
  38.      to its position in the hierarchy."
  39.     | mySubclasses |
  40.     self indentToLevel: level.
  41.     self name printNl.
  42.     mySubclasses _ self subclasses asSortedCollection:
  43.                         [ :a :b | (a name isNil or: [ b name isNil ])
  44.                                       ifTrue: [ true ]
  45.                               ifFalse: [ a name <= b name ] ].
  46.     mySubclasses do:
  47.         [ :subclass | subclass class ~~ Metaclass
  48.                     ifTrue: [ subclass printSubclasses: level + 1 ] ]
  49. !
  50.  
  51. indentToLevel: level
  52.     level timesRepeat:
  53.         [ stdout next: (self hierarchyIndent) put: Character space ]
  54. !
  55.  
  56. hierarchyIndent
  57.     ^4
  58. !!
  59.  
  60. Object printHierarchy!
  61.